home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / kcl.lha / bin / dpp.c < prev    next >
C/C++ Source or Header  |  1987-06-04  |  12KB  |  640 lines
  1. /*
  2.     dpp.c
  3.  
  4.     defun preprocessor
  5. */
  6.  
  7. /*
  8.     Usage:
  9.         dpp file
  10.  
  11.     The file named file.d is preprocessed and the output will be
  12.     written to the file whose name is file.c.
  13.  
  14.  
  15.     The function definition:
  16.  
  17.     @(defun name ({var}*
  18.               [&optional {var | (var [initform [svar]])}*]
  19.               [&rest]
  20.               [&key {var |
  21.                  ({var | (keyword var)} [initform [svar]])}*
  22.                 [&allow_other_keys]]
  23.               [&aux {var | (var [initform])}*])
  24.  
  25.         C-declaration
  26.  
  27.     @
  28.  
  29.         C-body
  30.  
  31.     @)
  32.  
  33.     &optional may be abbreviated as &o.
  34.     &rest may be abbreviated as &r.
  35.     &key may be abbreviated as &k.
  36.     &allow_other_keys may be abbreviated as &aok.
  37.     &aux may be abbreviated as &a.
  38.  
  39.     Each variable becomes a macro name
  40.     defined to be an expression of the form
  41.         vs_base[...].
  42.  
  43.     Each supplied-p parameter becomes a boolean C variable.
  44.  
  45.     Initforms are C expressions.
  46.     It an expression contain non-alphanumeric characters,
  47.     it should be surrounded by backquotes (`).
  48.  
  49.  
  50.     Function return:
  51.  
  52.         @(return {form}*)
  53.  
  54.     It becomes a C block.
  55.  
  56. */
  57.  
  58. #include <stdio.h>
  59.  
  60. #ifdef UNIX
  61. #include <ctype.h>
  62. #define    isalphanum(c)    isalnum(c)
  63. #endif
  64.  
  65. #define    POOLSIZE    2048
  66. #define    MAXREQ        16
  67. #define    MAXOPT        16
  68. #define    MAXKEY        16
  69. #define    MAXAUX        16
  70. #define    MAXRES        16
  71.  
  72. #define    TRUE        1
  73. #define    FALSE        0
  74.  
  75. typedef int bool;
  76.  
  77. FILE *in, *out;
  78.  
  79. char filename[BUFSIZ];
  80. int line;
  81. int tab;
  82. int tab_save;
  83.  
  84. char pool[POOLSIZE];
  85. char *poolp;
  86.  
  87. char *function;
  88.  
  89. char *required[MAXREQ];
  90. int nreq;
  91.  
  92. struct optional {
  93.     char *o_var;
  94.     char *o_init;
  95.     char *o_svar;
  96. } optional[MAXOPT];
  97. int nopt;
  98.  
  99. bool rest_flag;
  100.  
  101. bool key_flag;
  102. struct keyword {
  103.     char *k_key;
  104.     char *k_var;
  105.     char *k_init;
  106.     char *k_svar;
  107. } keyword[MAXKEY];
  108. int nkey;
  109. bool allow_other_keys_flag;
  110.  
  111. struct aux {
  112.     char *a_var;
  113.     char *a_init;
  114. } aux[MAXAUX];
  115. int naux;
  116.  
  117. char *result[MAXRES];
  118. int nres;
  119.  
  120. error(s)
  121. char *s;
  122. {
  123.     printf("Error in line %d: %s.\n", line, s);
  124.     exit(0);
  125. }
  126.  
  127. readc()
  128. {
  129.     int c;
  130.  
  131.     c = getc(in);
  132.     if (feof(in)) {
  133.         if (function != NULL)
  134.             error("unexpected end of file");
  135.         exit(0);
  136.     }
  137.     if (c == '\n') {
  138.         line++;
  139.         tab = 0;
  140.     } else if (c == '\t')
  141.         tab++;
  142.     return(c);
  143. }
  144.  
  145. nextc()
  146. {
  147.     int c;
  148.  
  149.     while (isspace(c = readc()))
  150.         ;
  151.     return(c);
  152. }
  153.  
  154. unreadc(c)
  155. int c;
  156. {
  157.     if (c == '\n')
  158.         --line;
  159.     else if (c == '\t')
  160.         --tab;
  161.     ungetc(c, in);
  162. }
  163.  
  164. put_tabs(n)
  165. int n;
  166. {
  167.     int i;
  168.  
  169.     for (i = 0;  i < n;  i++)
  170.         putc('\t', out);
  171. }
  172.  
  173. pushc(c)
  174. int c;
  175. {
  176.     if (poolp >= &pool[POOLSIZE])
  177.         error("buffer bool overflow");
  178.     *poolp++ = c;
  179. }
  180.  
  181. char *
  182. read_token()
  183. {
  184.     int c;
  185.     char *p;
  186.  
  187.     p = poolp;
  188.     if ((c = nextc()) == '`') {
  189.         while ((c = readc()) != '`')
  190.             pushc(c);
  191.         pushc('\0');
  192.         return(p);
  193.     }
  194.     do
  195.         pushc(c);
  196.     while (isalphanum(c = readc()) || c == '_');
  197.     pushc('\0');
  198.     unreadc(c);
  199.     return(p);
  200. }
  201.  
  202. reset()
  203. {
  204.     int i;
  205.  
  206.     poolp = pool;
  207.     function = NULL;
  208.     nreq = 0;
  209.     for (i = 0;  i < MAXREQ;  i++)
  210.         required[i] = NULL;
  211.     nopt = 0;
  212.     for (i = 0;  i < MAXOPT;  i++)
  213.         optional[i].o_var
  214.         = optional[i].o_init
  215.         = optional[i].o_svar
  216.         = NULL;
  217.     rest_flag = FALSE;
  218.     key_flag = FALSE;
  219.     nkey = 0;
  220.     for (i = 0;  i < MAXKEY;  i++)
  221.         keyword[i].k_key
  222.         = keyword[i].k_var
  223.         = keyword[i].k_init
  224.         = keyword[i].k_svar
  225.         = NULL;
  226.     allow_other_keys_flag = FALSE;
  227.     naux = 0;
  228.     for (i = 0;  i < MAXAUX;  i++)
  229.         aux[i].a_var
  230.         = aux[i].a_init
  231.         = NULL;
  232. }
  233.  
  234. get_function()
  235. {
  236.     function = read_token();
  237. }
  238.  
  239. get_lambda_list()
  240. {
  241.     int c;
  242.     char *p;
  243.  
  244.     if ((c = nextc()) != '(')
  245.         error("( expected");
  246.     for (;;) {
  247.         if ((c = nextc()) == ')')
  248.             return;
  249.         if (c == '&') {
  250.             p = read_token();
  251.             goto OPTIONAL;
  252.         }
  253.         unreadc(c);
  254.         p = read_token();
  255.         if (nreq >= MAXREQ)
  256.             error("too many required variables");
  257.         required[nreq++] = p;
  258.     }
  259.  
  260. OPTIONAL:
  261.     if (strcmp(p, "optional") != 0 && strcmp(p, "o") != 0)
  262.         goto REST;
  263.     for (;;  nopt++) {
  264.         if ((c = nextc()) == ')')
  265.             return;
  266.         if (c == '&') {
  267.             p = read_token();
  268.             goto REST;
  269.         }
  270.         if (nopt >= MAXOPT)
  271.             error("too many optional argument");
  272.         if (c == '(') {
  273.             optional[nopt].o_var = read_token();
  274.             if ((c = nextc()) == ')')
  275.                 continue;
  276.             unreadc(c);
  277.             optional[nopt].o_init = read_token();
  278.             if ((c = nextc()) == ')')
  279.                 continue;
  280.             unreadc(c);
  281.             optional[nopt].o_svar = read_token();
  282.             if (nextc() != ')')
  283.                 error(") expected");
  284.         } else {
  285.             unreadc(c);
  286.             optional[nopt].o_var = read_token();
  287.         }
  288.     }
  289.  
  290. REST:
  291.     if (strcmp(p, "rest") != 0 && strcmp(p, "r") != 0)
  292.         goto KEYWORD;
  293.     rest_flag = TRUE;
  294.     if ((c = nextc()) == ')')
  295.         return;
  296.     if (c != '&')
  297.         error("& expected");
  298.     p = read_token();
  299.     goto KEYWORD;
  300.  
  301. KEYWORD:
  302.     if (strcmp(p, "key") != 0 && strcmp(p, "k") != 0)
  303.         goto AUX;
  304.     key_flag = TRUE;
  305.     for (;;  nkey++) {
  306.         if ((c = nextc()) == ')')
  307.             return;
  308.         if (c == '&') {
  309.             p = read_token();
  310.             if (strcmp(p, "allow_other_keys") == 0 ||
  311.                 strcmp(p, "aok") == 0) {
  312.                 allow_other_keys_flag = TRUE;
  313.                 if ((c = nextc()) == ')')
  314.                     return;
  315.                 if (c != '&')
  316.                     error("& expected");
  317.                 p = read_token();
  318.             }
  319.             goto AUX;
  320.         }
  321.         if (nkey >= MAXKEY)
  322.             error("too many optional argument");
  323.         if (c == '(') {
  324.             if ((c = nextc()) == '(') {
  325.                 p = read_token();
  326.                 if (p[0] != ':' || p[1] == '\0')
  327.                     error("keyword expected");
  328.                 keyword[nkey].k_key = p + 1;
  329.                 keyword[nkey].k_var = read_token();
  330.                 if (nextc() != ')')
  331.                     error(") expected");
  332.             } else {
  333.                 unreadc(c);
  334.                 keyword[nkey].k_key
  335.                 = keyword[nkey].k_var
  336.                 = read_token();
  337.             }
  338.             if ((c = nextc()) == ')')
  339.                 continue;
  340.             unreadc(c);
  341.             keyword[nkey].k_init = read_token();
  342.             if ((c = nextc()) == ')')
  343.                 continue;
  344.             unreadc(c);
  345.             keyword[nkey].k_svar = read_token();
  346.             if (nextc() != ')')
  347.                 error(") expected");
  348.         } else {
  349.             unreadc(c);
  350.             keyword[nkey].k_key
  351.             = keyword[nkey].k_var
  352.             = read_token();
  353.         }
  354.     }
  355.  
  356. AUX:
  357.     if (strcmp(p, "aux") != 0 && strcmp(p, "a") != 0)
  358.         error("illegal lambda-list keyword");
  359.     for (;;) {
  360.         if ((c = nextc()) == ')')
  361.             return;
  362.         if (c == '&')
  363.             error("illegal lambda-list keyword");
  364.         if (naux >= MAXAUX)
  365.             error("too many auxiliary variable");
  366.         if (c == '(') {
  367.             aux[naux].a_var = read_token();
  368.             if ((c = nextc()) == ')')
  369.                 continue;
  370.             unreadc(c);
  371.             aux[naux].a_init = read_token();
  372.             if (nextc() != ')')
  373.                 error(") expected");
  374.         } else {
  375.             unreadc(c);
  376.             aux[naux].a_var = read_token();
  377.         }
  378.         naux++;
  379.     }
  380. }
  381.  
  382. get_return()
  383. {
  384.     int c;
  385.  
  386.     nres = 0;
  387.     for (;;) {
  388.         if ((c = nextc()) == ')')
  389.             return;
  390.         unreadc(c);
  391.         result[nres++] = read_token();
  392.     }
  393. }
  394.  
  395. put_fhead()
  396. {
  397.     fprintf(out, "L%s()\n{", function);
  398. }
  399.  
  400. put_declaration()
  401. {
  402.     int i;
  403.  
  404.     fprintf(out, "\tint narg;\n");
  405.     for (i = 0;  i < nopt;  i++)
  406.         if (optional[i].o_svar != NULL)
  407.             fprintf(out, "\tbool %s;\n",
  408.                 optional[i].o_svar);
  409.     for (i = 0;  i < nreq;  i++)
  410.         fprintf(out, "#define\t%s\tvs_base[%d]\n",
  411.             required[i], i);
  412.     for (i = 0;  i < nopt;  i++)
  413.         fprintf(out, "#define\t%s\tvs_base[%d+%d]\n",
  414.             optional[i].o_var, nreq, i);
  415.     for (i = 0;  i < nkey;  i++)
  416.         fprintf(out, "#define\t%s\tvs_base[%d+%d+%d]\n",
  417.             keyword[i].k_var, nreq, nopt, i);
  418.     for (i = 0;  i < nkey;  i++)
  419.         if (keyword[i].k_svar != NULL)
  420.             fprintf(out, "\tbool %s;\n", keyword[i].k_svar);
  421.     for (i = 0;  i < naux;  i++)
  422.         fprintf(out, "#define\t%s\tvs_base[%d+%d+2*%d+%d]\n",
  423.             aux[i].a_var, nreq, nopt, nkey, i);
  424.     fprintf(out, "\n");
  425.     fprintf(out, "\tnarg = vs_top - vs_base;\n");
  426.     if (nopt == 0 && !rest_flag && !key_flag)
  427.         fprintf(out, "\tcheck_arg(%d);\n", nreq);
  428.     else {
  429.         fprintf(out, "\tif (narg < %d)\n", nreq);
  430.         fprintf(out, "\t\ttoo_few_arguments();\n");
  431.     }
  432.     for (i = 0;  i < nopt;  i++)
  433.         if (optional[i].o_svar != NULL) {
  434.             fprintf(out, "\tif (narg > %d + %d)\n",
  435.                 nreq, i);
  436.             fprintf(out, "\t\t%s = TRUE;\n",
  437.                 optional[i].o_svar);
  438.             fprintf(out, "\telse {\n");
  439.             fprintf(out, "\t\t%s = FALSE;\n",
  440.                 optional[i].o_svar);
  441.             fprintf(out, "\t\tvs_push(%s);\n",
  442.                 optional[i].o_init);
  443.             fprintf(out, "\t\tnarg++;\n");
  444.             fprintf(out, "\t}\n");
  445.         } else if (optional[i].o_init != NULL) {
  446.             fprintf(out, "\tif (narg <= %d + %d) {\n",
  447.                 nreq, i);
  448.             fprintf(out, "\t\tvs_push(%s);\n",
  449.                 optional[i].o_init);
  450.             fprintf(out, "\t\tnarg++;\n");
  451.             fprintf(out, "\t}\n");
  452.         } else {
  453.             fprintf(out, "\tif (narg <= %d + %d) {\n",
  454.                 nreq, i);
  455.             fprintf(out, "\t\tvs_push(Cnil);\n");
  456.             fprintf(out, "\t\tnarg++;\n");
  457.             fprintf(out, "\t}\n");
  458.         }
  459.     if (nopt > 0 && !key_flag && !rest_flag) {
  460.         fprintf(out, "\tif (narg > %d + %d)\n", nreq, nopt);
  461.         fprintf(out, "\t\ttoo_many_arguments();\n");
  462.     }
  463.     if (key_flag) {
  464.         fprintf(out, "\tparse_key(vs_base+%d+%d,FALSE, %s, %d,\n",
  465.             nreq, nopt,
  466.             allow_other_keys_flag ? "TRUE" : "FALSE", nkey);
  467.         if (nkey > 0) {
  468.             i = 0;
  469.             for (;;) {
  470.                 fprintf(out, "\t\tK%s", keyword[i].k_key);
  471.                 if (++i == nkey) {
  472.                     fprintf(out, ");\n");
  473.                     break;
  474.                 } else
  475.                     fprintf(out, ",\n");
  476.             }
  477.         } else
  478.             fprintf(out, "\t\tCnil);");
  479.         fprintf(out, "\tvs_top = vs_base + %d+%d+2*%d;\n",
  480.             nreq, nopt, nkey);
  481.         for (i = 0;  i < nkey;  i++) {
  482.             if (keyword[i].k_init == NULL)
  483.                 continue;
  484.             fprintf(out, "\tif (vs_base[%d+%d+%d+%d]==Cnil)\n",
  485.                 nreq, nopt, nkey, i);
  486.             fprintf(out, "\t\t%s = %s;\n",
  487.                 keyword[i].k_var, keyword[i].k_init);
  488.         }
  489.         for (i = 0;  i < nkey;  i++)
  490.             if (keyword[i].k_svar != NULL)
  491.                 fprintf(out,
  492.                 "\t%s = vs_base[%d+%d+%d+%d] != Cnil;\n",
  493.                 keyword[i].k_svar, nreq, nopt, nkey, i);
  494.     }
  495.     for (i = 0;  i < naux;  i++)
  496.                 if (aux[i].a_init != NULL)
  497.             fprintf(out, "\tvs_push(%s);\n", aux[i].a_init);
  498.         else
  499.             fprintf(out, "\tvs_push(Cnil);\n");
  500. }
  501.  
  502. put_ftail()
  503. {
  504.     int i;
  505.  
  506.     for (i = 0;  i < nreq;  i++)
  507.         fprintf(out, "#undef %s\n", required[i]);
  508.     for (i = 0;  i < nopt;  i++)
  509.         fprintf(out, "#undef %s\n", optional[i].o_var);
  510.     for (i = 0;  i < nkey;  i++)
  511.         fprintf(out, "#undef %s\n", keyword[i].k_var);
  512.     for (i = 0;  i < naux;  i++)
  513.         fprintf(out, "#undef %s\n", aux[i].a_var);
  514.     fprintf(out, "}");
  515. }
  516.  
  517. put_return()
  518. {
  519.     int i, t;
  520.  
  521.     t = tab_save + 1;
  522.     if (nres == 0) {
  523.         fprintf(out, "{\n");
  524.         put_tabs(t);
  525.         fprintf(out, "vs_top = vs_base;\n");
  526.         put_tabs(t);
  527.         fprintf(out, "vs_base[0] = Cnil;\n");
  528.         put_tabs(t);
  529.         fprintf(out, "return;\n");
  530.         put_tabs(tab_save);
  531.         fprintf(out, "}");
  532.     } else if (nres == 1) {
  533.         fprintf(out, "{\n");
  534.         put_tabs(t);
  535.         fprintf(out, "vs_base[0] = %s;\n", result[0]);
  536.         put_tabs(t);
  537.         fprintf(out, "vs_top = vs_base + 1;\n");
  538.         put_tabs(t);
  539.         fprintf(out, "return;\n");
  540.         put_tabs(tab_save);
  541.         fprintf(out, "}");
  542.     } else {
  543.         fprintf(out, "{\n");
  544.         for (i = 0;  i < nres;  i++) {
  545.             put_tabs(t);
  546.             fprintf(out, "object R%d;\n", i);
  547.         }
  548.         for (i = 0;  i < nres;  i++) {
  549.             put_tabs(t);
  550.             fprintf(out, "R%d = %s;\n", i, result[i]);
  551.         }
  552.         for (i = 0;  i < nres;  i++) {
  553.             put_tabs(t);
  554.             fprintf(out, "vs_base[%d] = R%d;\n", i, i);
  555.         }
  556.         put_tabs(t);
  557.         fprintf(out, "vs_top = vs_base + %d;\n", nres);
  558.         put_tabs(t);
  559.         fprintf(out, "return;\n");
  560.         put_tabs(tab_save);
  561.         fprintf(out, "}");
  562.     }
  563. }
  564.  
  565. main_loop()
  566. {
  567.     int c;
  568.     char *p;
  569.  
  570.     line = 1;
  571.  
  572. LOOP:
  573.     reset();
  574.     fprintf(out, "\n#line %d %s\n", line, filename);
  575.     while ((c = readc()) != '@')
  576.         putc(c, out);
  577.     if (readc() != '(')
  578.         error("@( expected");
  579.     p = read_token();
  580.     if (strcmp(p, "defun") == 0) {
  581.         get_function();
  582.         get_lambda_list();
  583.         put_fhead();
  584.         fprintf(out, "\n#line %d %s\n", line, filename);
  585.         while ((c = readc()) != '@')
  586.             putc(c, out);
  587.         put_declaration();
  588.  
  589.     BODY:
  590.         fprintf(out, "\n#line %d %s\n", line, filename);
  591.         while ((c = readc()) != '@')
  592.             putc(c, out);
  593.         if ((c = readc()) == ')') {
  594.             put_ftail();
  595.             goto LOOP;
  596.         } else if (c != '(')
  597.             error("@( expected");
  598.         p = read_token();
  599.         if (strcmp(p, "return") == 0) {
  600.             tab_save = tab;
  601.             get_return();
  602.             put_return();
  603.             goto BODY;
  604.         } else
  605.             error("illegal symbol");
  606.     } else
  607.         error("illegal symbol");
  608. }
  609.  
  610. main(argc, argv)
  611. int argc;
  612. char **argv;
  613. {
  614.     char *p, *q;
  615.  
  616.     if (argc != 2)
  617.         error("arg count");
  618.     for (p = argv[1], q = filename;  *p != '\0';  p++, q++)
  619.         if (q >= &filename[BUFSIZ-3])
  620.             error("too long file name");
  621.         else
  622.             *q = *p;
  623.     q[0] = '.';
  624.     q[1] = 'd';
  625.     q[2] = '\0';
  626.     in = fopen(filename, "r");
  627.     if (in == NULL)
  628.         error("can't open input file");
  629.     q[1] = 'c';
  630.     out = fopen(filename, "w");
  631.     if (out == NULL)
  632.         error("can't open output file");
  633.     q[1] = 'd';
  634.     printf("dpp: %s -> ", filename);
  635.     q[1] = 'c';
  636.     printf("%s\n", filename);
  637.     q[1] = 'd';
  638.     main_loop();
  639. }
  640.